Cream of the Crop 1/Cream of the Crop 1.iso/PROGRAM/ICNDRW_1.ARJ/ALIEN.PAS

Pascal/Delphi Source File | 1991-08-16 | 8KB | 384 lines

program alien_space_game;

{$X+}
{$G+}  (* $G- for non 286 machines *)
{$R-}
{$S-}

uses crt,ttools,bgidriv,graph,icontool;
var
  startx,starty : integer;
  amx,amy,mx,my : integer;
  ship : array [1..6] of icon;
  missile,
  amiss : icon;
  alien : array [1..7] of icon;
  oldexit:pointer;
  right_border_reached,
  left_border_reached :boolean;
  amiss_dead,
  missile_dead,
  ship_dead  :boolean;
  alien_dead : boolean;
  moving_left : boolean;
  moving_right:boolean;
  ascore,score : integer;

{$I grafinit.pas}

procedure killalien; forward;

procedure killplayer; forward;


procedure showscore;
begin
  setfillstyle(solidfill,0);
  bar(1,getmaxy-10,getmaxx,getmaxy);
  outtextxy(1,getmaxy-10,'Your Score: '+intstr(score)+'   Alien Score: '+intstr(ascore));
end;

procedure move_amiss;
begin
  if not amiss_dead then
  begin
    inc(amy,2);
    if amy>getmaxy-2 then
    begin
      amiss_dead:=true;
      amiss.display_icon;
      setfillstyle(solidfill,0);
      bar(1,getmaxy-3,getmaxx,getmaxy+1);
    end;
    if ship[1].inbounds(amx,amy) then
    begin
      amiss.display_icon;
      amiss_dead:=true;
      killplayer;
      setfillstyle(solidfill,0);
      bar(amiss.getx,amiss.gety,amiss.getx+amiss.get_length,amiss.gety+amiss.get_height);
      inc(ascore,10);
      showscore;
    end
    else
    begin
      if not amiss_dead then
      begin
        amiss.display_icon;
        amiss.setxy(amx,amy);
        amiss.display_icon;
      end;
    end;
  end;
end;

procedure move_missile;
begin
  dec(my,2);
  if my<1 then
  begin
    missile_dead:=true;
  end;
  if alien[1].inbounds(mx,my) then
  begin
    missile.display_icon;
    missile_dead:=true;
    killalien;
    setfillstyle(solidfill,0);
    bar(missile.getx,missile.gety,missile.getx+missile.get_length,missile.gety+missile.get_height);
    inc(score,10);
    showscore;
  end
  else
  begin
    missile.display_icon;
    missile.setxy(mx,my);
    missile.display_icon;
  end;

end;

procedure killalien;
var i:integer;
begin
  alien_dead:=true;
  for i:=1 to 7 do
  begin
    move_amiss;
    if i>1 then
      alien[i].display_icon;
    delay(50);
    alien[i].display_icon;
    move_amiss;
  end;
end;

procedure killplayer;
var i:integer;
begin
  ship_dead:=true;
  ship[1].display_icon;
  for i:=2 to 6 do
  begin
    if not missile_dead then
      move_missile;
    ship[i].setxy(ship[1].getx,ship[1].gety);
    ship[i].display_icon;
    delay(50);
    ship[i].display_icon;
    if not missile_dead then
      move_missile;
  end;
end;


procedure move_ship_left;
begin
  right_border_reached:=false;
  ship[1].display_icon;
  dec(startx,2);
  if startx<1 then
  begin
    startx:=1;
    moving_left:=false;
    left_border_reached:=true;
  end;
  ship[1].setxy(startx,starty);
  ship[1].display_icon;
end;

procedure move_ship_right;
begin
  left_border_reached:=false;
  ship[1].display_icon;
  inc(startx,2);
  if startx>getmaxx-ship[1].get_length then
  begin
    startx:=getmaxx-ship[1].get_length;
    moving_right:=false;
    right_border_reached:=true;
  end;
  ship[1].setxy(startx,starty);
  ship[1].display_icon;
end;

{$F+}
procedure myexit;
begin
  exitproc:=oldexit;
  closegraph;
  halt(255);
end;
{$F-}

procedure setalienxy;
var x,y,i:integer;
begin
  x:=random(640-alien[1].getleft);
  y:=random(10)+2;
  for i:=1 to 7 do
    alien[i].setxy(x,y);
end;

procedure move_alien;
var d:byte;
    i,x,y:integer;
begin
  d:=random(100)+1;
  x:=alien[1].getx;
  y:=alien[1].gety;
  case d of
    10 : begin
          dec(y,random(5)+1);
          if y<1 then
            y:=1;
        end;
    20 : begin
          inc(y,random(10)+1);
          if y+alien[1].get_height>ship[1].gettop-10 then
            y:=ship[1].gettop-(alien[1].get_height+10);
        end;
    30 : begin
          dec(x,random(20)+1);
          if x<1 then
            {x:=getmaxx-50;}
            x:=1;
        end;
    40 : begin
          inc(x,random(20)+1);
          if x>getmaxx-50 then
            {x:=1;}
            x:=getmaxx-50;
        end;
    99 : begin
           if random(3)+1=2 then
           if amiss_dead then
             begin
               amiss_dead:=false;
               amx:=alien[1].getx + (alien[1].get_length div 2);
               amy:=alien[1].getbottom;
               amiss.setxy(amx,amy);
               amiss.display_icon;
            end;
         end;
  end;
  if d in [10,20,30,40] then
  begin
    alien[1].display_icon;
    for i:=1 to 7 do
      alien[i].setxy(x,y);
    alien[1].display_icon;
  end;
end;


procedure main;
var done:boolean;
    k : char;
    i,jj:integer;
    mcnt : integer;
begin
  randomize;
  oldexit:=exitproc;
  exitproc:=@myexit;
  done:=false;
  for i:=1 to 7 do
  begin
    alien[i].init('','ALIEN'+intstr(i)+'.ICN',getmaxx div 2,25);
    alien[i].setput(xorput);
    alien[i].icontitle(false);
  end;
  for i:=1 to 6 do
  begin
    ship[i].init('','SHIP'+intstr(i)+'.ICN',1,1);
    ship[i].setput(xorput);
    ship[i].icontitle(false);
  end;
  missile.init('','MISSILE.ICN',1,1);
  amiss.init('','amiss.icn',1,1);
  if (not ship[1].initerror) and (not missile.initerror) and
     (not alien[1].initerror) then
  begin
    jj:=0;
    startx:=getmaxx div 2;
    starty:=getmaxy - (ship[1].get_height+11);
    ship[1].setxy(startx,starty);
    amiss.icontitle(false);
    amiss.setput(xorput);
    missile.icontitle(false);
    missile.setput(xorput);
    alien[1].showicon;
    ship[1].display_icon;
    left_border_reached:=false;
    right_border_reached:=false;
    alien_dead:=false;
    missile_dead:=true;
    amiss_dead:=true;
    ship_dead:=false;
    moving_left:=false;
    moving_right:=false;
    mcnt:=0;
    score:=0;
    ascore:=0;
    showscore;
    repeat
      inc(jj);
      inc(mcnt);
      if not missile_dead then
      begin
        move_missile;
        if alien_dead then
        begin
          setalienxy;
          alien_dead:=false;
          alien[1].display_icon;
        end;
        if not moving_left and not moving_right then
          delay(2);
        move_alien;
        if mcnt>10 then
        begin
          mcnt:=0;
          move_amiss;
        end;
      end;
      if moving_left and not left_border_reached then
      begin
        inc(mcnt);
        move_alien;
        move_ship_left;
        if mcnt>5 then
        begin
           mcnt:=0;
           move_amiss;
        end;
      end;
      if moving_right and not right_border_reached then
      begin
        inc(mcnt);
        move_alien;
        move_ship_right;
        if mcnt>5 then
        begin
          mcnt:=0;
          move_amiss;
        end;
      end;
      inc(mcnt);
      if (jj=10) and not (alien_dead) then
      begin
        jj:=0;
        move_alien;
      end;
      if mcnt>60 then
      begin
          mcnt:=0;
          move_amiss;
      end;
      if ship_dead then
      begin
        ship_dead:=false;
        ship[1].display_icon;
      end;
      if keypressed then
      begin
        k:=readkey;
        case k of
          #32: begin
                 if missile_dead then
                 begin
                   missile_dead:=false;
                   mx:=(startx+(ship[1].get_length div 2)) - missile.get_length div 2;
                   my:=starty;
                   missile.setxy(mx,my);
                   missile.display_icon;
                 end;
               end;
          #0 : begin
                 k:=readkey;
                 case k of
                   curslft : begin moving_left:=true; moving_right:=false; end;
                   cursrt  : begin moving_right:=true; moving_left:=false; end;
                   cursup  : begin moving_right:=false; moving_left:=false; end;
                 end;
               end;
          #27: done:=true;
        end;
      end;
    until done;
  end
  else
  begin
    closegraph;
    restorecrtmode;
    writeln('Somethin'' is a amiss, captain!');
  end;
  closegraph;
  restorecrtmode;
end;

begin
  grafinit;
  main;
end.